	<!--#include file="conn.asp"#-->
	<!--#include file="sessao.asp"#-->
	<%
'	ASP Security Image Generator v4.0 - 13/July/2008
'	Generate images to make a CAPTCHA test
'	© 2006-2007 Emir Tüzül. All rights reserved.
'	http://www.tipstricks.org

'	This program is free software; you can redistribute it and/or
'	modify it under the terms of the Common Public License
'	as published by the Open Source Initiative OSI; either version 1.0
'	of the License, or any later version.

'	This program is distributed in the hope that it will be useful,
'	but WITHOUT ANY WARRANTY; without even the implied warranty of
'	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'	Common Public License For more details.

'	*[null pixel]Numbers[repeat count], #[text]Numbers[repeat count], &[row reference]number[referenced row index]
'	First row [font height, chars...]
'	Following rows [char width, pixel maps...]
	FontMap = Array(_
	 Split("13,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,1,2,3,4,5,6,7,8,9",",") ,_
	 Split("14,*5#4*5,*4#6*4,&2,&2,*3#3*2#3*3,&5,*2#4*2#4*2,*2#3*4#3*2,*2#10*2,*1#12*1,*1#3*6#3*1,&11,#3*8#3",",") ,_
	 Split("11,#8*3,#10*1,#3*4#3*1,&3,&3,&1,&2,#3*4#4,#3*5#3,&9,&8,&2,#9*2",",") ,_
	 Split("11,*4#6*1,*2#9,*1#4*4#2,*1#3*6#1,#3*8,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
	 Split("12,#8*4,#10*2,#3*4#4*1,#3*5#3*1,#3*6#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
	 Split("9,#9,&1,#3*6,&3,&3,#8*1,&6,&3,&3,&3,&3,&1,&1",",") ,_
	 Split("9,#9,&1,#3*6,&3,&3,&1,&1,&3,&3,&3,&3,&3,&3",",") ,_
	 Split("13,*4#7,*2#11,*1#4*5#3,*1#3*8#1,#3,#3,#3*4#6,&7,#3*7#3,*1#3*6#3,*1#5*4#3,&2,&1",",") ,_
	 Split("11,#3*5#3,&1,&1,&1,&1,#11,&6,&1,&1,&1,&1,&1,&1",",") ,_
	 Split("7,#7,#7,*2#3,&3,&3,&3,&3,&3,&3,&3,&3,&1,&1",",") ,_
	 Split("8,*2#6,&1,*5#3,&3,&3,&3,&3,&3,&3,&3,*4#4,#7,#6",",") ,_
	 Split("12,#3*5#4,#3*4#4,#3*3#4,#3*2#4,#3*2#3,#3*1#3,#7,#8,&5,#3*3#3,#3*4#3,#3*5#3,&1",",") ,_
	 Split("9,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#9,#9",",") ,_
	 Split("13,#3*7#3,#4*5#4,&2,#5*3#5,&4,#6*1#6,#3*1#2*1#2*1#3,#3*1#5*1#3,#3*2#3*2#3,&9,#3*7#3,&11,&11",",") ,_
	 Split("11,#4*4#3,#5*3#3,&2,#6*2#3,&4,#3*1#3*1#3,&6,#3*2#6,&8,#3*3#5,&10,#3*4#4,#3*5#3",",") ,_
	 Split("13,*4#5,*2#9,*1#4*3#4,*1#3*5#3,#3*7#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
	 Split("10,#8,#9,#3*3#4,#3*4#3,&4,&4,&3,&2,#7,#3,#3,#3,#3",",") ,_
	 Split("13,*3#6,*2#8,*1#3*4#3,*1#2*6#2,#2*8#2,&5,&5,#2*4#1*3#2,#2*4#2*2#2,*1#2*4#4,&3,*2#10,*3#6*2#2",",") ,_
	 Split("12,#8,#9,#3*4#3,&3,&3,#3*3#4,&2,&1,#3*2#4,#3*3#3,&3,#3*4#4,#3*5#4",",") ,_
	 Split("11,*3#6,*1#9,#4*4#2,#3*6#1,#4,#8,&2,*3#8,*7#4,#1*7#3,#3*4#4,#10,*1#7",",") ,_
	 Split("11,#11,&1,*4#3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3",",") ,_
	 Split("11,#3*5#3,&1,&1,&1,&1,&1,&1,&1,&1,&1,#4*3#4,*1#9,*3#5",",") ,_
	 Split("14,#3*8#3,*1#3*6#3,&2,*1#3*5#4,*2#3*4#3,&5,*3#3*2#3,&7,&7,*4#6,&10,&10,*5#4",",") ,_
	 Split("17,#3*4#3*4#3,&1,#3*3#5*3#3,*1#3*2#2*1#2*2#3,&4,*1#3*1#3*1#3*1#3,&6,*1#3*1#2*3#2*1#3,&8,*2#5*3#5,&10,*2#4*5#4,&12",",") ,_
	 Split("14,#4*6#4,*1#4*4#4,*2#4*2#4,*3#3*2#3,*3#8,*4#6,*5#4,&6,&5,&4,&3,&2,&1",",") ,_
	 Split("13,#4*5#4,*1#3*5#3,*2#3*3#3,*2#4*1#4,*3#3*1#3,*3#7,*4#5,*5#3,&8,&8,&8,&8,&8",",") ,_
	 Split("10,#10,&1,*6#4,*5#4,*5#3,*4#3,*3#4,*3#3,*2#3,*1#4,#4,&1,&1",",") ,_
	 Split("10,*3#4*3,*1#8*1,*1#3*2#3*1,#3*4#3,&4,&4,&4,&4,&4,&4,&3,&2,&1",",") ,_
	 Split("9,*3#3*3,&1,#6*3,&3,*3#3*3,&5,&5,&5,&5,&5,&5,#9,&12",",") ,_
	 Split("10,*1#6*3,#8*2,#2*3#4*1,#1*5#3*1,*6#3*1,&5,*5#3*2,*4#4*2,*3#4*3,*2#4*4,*1#4*5,#10,&12",",") ,_
	 Split("11,*1#8*2,#10*1,#3*5#3,#1*7#3,*7#3*1,*3#6*2,*3#7*1,*7#4,*8#3,&4,#3*4#4,&2,*1#7*3",",") ,_
	 Split("12,*6#4*2,*5#5*2,&2,*4#2*1#3*2,*3#3*1#3*2,*2#3*2#3*2,*1#3*3#3*2,#3*4#3*2,#12,&9,*7#3*2,&11,&11",",") ,_
	 Split("11,*1#10,&1,*1#3*7,&3,*1#8*2,*1#9*1,*7#4,*8#3,&8,#1*7#3,#3*4#3*1,#10*1,*1#7*3",",") ,_
	 Split("11,*4#6*1,*2#8*1,*1#4*6,*1#3*7,#3*1#5*2,#10*1,#3*4#4,#3*5#3,&8,&8,*1#3*3#3*1,*1#9*1,*3#5*3",",") ,_
	 Split("11,#11,&1,*7#4,*7#3*1,*6#4*1,*6#3*2,*5#3*3,*4#4*3,*4#3*4,*3#4*4,*3#3*5,*2#3*6,*1#4*6",",") ,_
	 Split("11,*2#7*2,*1#9*1,#3*4#4,#3*5#3,#4*3#3*1,*1#8*2,&1,*1#3*1#5*1,&4,&4,#4*3#4,&2,*2#6*3",",") ,_
	 Split("11,*3#5*3,*1#9*1,*1#3*3#3*1,#3*5#3,&4,&4,#4*4#3,*1#10,*2#5*1#3,*7#3*1,*6#4*1,*1#8*2,*1#6*4",",") _
	)'Previous row must end with _

'	#Begin ColorMap
	Const BmpColorMap = "ffffff00007830007f411800"

	ColorMap = Array(_
	 Split("00,01,02",",") _
	)'End ColorMap

'	#Auto calculated variables
	Dim ImageWidth, ImageHeight, arrTextWidth(), TextHeight, LeftMargin, arrTopMargin(), CursorPos
	Dim BmpEndLine, BColor, TColor, NColor
	Dim i, j, k, x, y

'	#Editable consts and variables
	Dim Bitmap(40,170) '[Height,Width]
	Const CodeLength = 4 'Secure code length (Max:8)
	Const CodeType = 1 '0[RanDom numbers], 1[RanDom chars and numbers], 2[Fake word]
	Const CharTracking = 2 'Set the tracking between two characters
	Const RndTopMargin = true 'Randomize top margin every character
	Const NoiseEffect = 3 '0[none], 1[sketch], 2[ranDom foreground lines], 3[ranDom background lines], 4[1 and 3 (Recommed maximum NoiseLine=4)]
	Const NoiseLine = 3 'Low values make easy OCR, high values decrease readability
	Const MinLineLength = 6 'Minimum noise line length
	Const SessionName = "captcha" 'Where store your secure code


	Select Case request("acao")
		Case "getImage"
'			#Generate captcha
			If CodeType < 2 Then
				secureCode = CreateGUID(CodeLength)
			Else
				secureCode = FakeWord(CodeLength)
			End If
			SetCaptcha secureCode
			PrepareBitmap(secureCode)
			If (NoiseEffect > 0) and (NoiseEffect <> 3) Then
				AddNoise()
			End If

			SendBitmap()
		Case "check"
			check()
	End Select


	Sub check()
		Dim retorno
		Dim vcaptcha 
		
		vcaptcha = getCaptcha(request.cookies("codsessao"))
		
		If request(SessionName) <> "" and vcaptcha <> "" Then
			if isnumeric(request.cookies("codsessao")&"") = true then
				If UCase(request(SessionName)) <> vcaptcha Then
					retorno = "false"
				Else
					retorno = "true"
				End If
			Else
				retorno = "false"
			End if
		Else
			retorno = "false"
		End If
		Response.Write(retorno)
	End Sub

'-----------------------------------------------------------------

	Function CreateGUID(valLength)
		If CodeType = 1 Then
			strValid = "A0B1C2D3E4F5G6H7I8J9K8L7M6N5O4P3Q2R1S0T1U2V3W4X5Y6Z7"
		Else
			strValid = "0516273849"
		End If
		tmpGUID = vbNullString
		tmpChr = vbNullString
		Randomize(Timer)
		For cGUID=1 to valLength
			Do 
				tmpChr = Mid(strValid, Int(Rnd(1) * Len(strValid)) + 1, 1)
			Loop While CStr(tmpChr) = CStr(Right(tmpGUID,1))
			tmpGUID = tmpGUID & tmpChr
		Next
		CreateGUID = tmpGUID
	End Function

	Function FakeWord(valLength)
		arrChars = Array("AEIOU", "BCDFGHJKLMNPQRSTVWXYZ")
		cVowel = 0
		cConsonant = 0
		tmpWord = vbNullString
		Randomize(Timer)
		For cWord=1 to valLength
			If (cWord=2) or ((valLength > 1) and (cWord = valLength)) Then
				ixChars = 1-ixChars
			ElseIf (cVowel < 2) and (cConsonant < 2) Then
				ixChars = Int(Rnd(1) * 2)
			ElseIf (cVowel < 2) Then
				ixChars = 0
			ElseIf (cConsonant < 2) Then
				ixChars = 1
			End If
			Pattern = arrChars(ixChars)
			tmpWord = tmpWord & Mid(Pattern, Int(Rnd(1) * Len(Pattern)) + 1, 1)
			If ixChars = 0 Then
				cVowel = cVowel + 1
				cConsonant = 0
			Else
				cVowel = 0
				cConsonant = cConsonant + 1
			End If
		Next
		FakeWord = tmpWord
	End Function

	Function RndInterval(valMin,valMax)
		Randomize(Timer)
		RndInterval = Int(((valMax - valMin + 1) * Rnd()) + valMin)
	End Function

	Function GetCharMap(valChr)
		Dim i, j
		j = 0
		For i=1 to UBound(FontMap(0))
			If CStr(FontMap(0)(i)) = CStr(valChr) Then
				j = i
				Exit For
			End If
		Next
	
		If j > 0 Then
			GetCharMap = FontMap(j)
		Else
			GetCharMap = Array(0)
		End If
	End Function

	Sub WriteCanvas(byval valChr, byval valTopMargin)
		Dim i, j, k, curPos, tmpChr, arrChrMap, strPixMap, drawPixel, pixRepeat
	
'		find char map
		arrChrMap = GetCharMap(valChr)
		If UBound(arrChrMap) < 1 Then
			Exit Sub
		End If

'		write char
		For i=1 to UBound(arrChrMap)
'			get pixel map active line
			strPixMap = arrChrMap(i)
			If Left(strPixMap,1) = "&" Then
				j = Mid(strPixMap,2)
				If (IsNumeric(j) = true) Then
					strPixMap = arrChrMap(CInt(j))
				Else
					strPixMap = vbNullString
				End If
			End If
			strPixMap = Trim(strPixMap)
	
'			drawing pixel
			curPos = CursorPos
			drawPixel = false
			pixRepeat = vbNullString
			For j=1 to Len(strPixMap)
				tmpChr = Mid(strPixMap,j,1)
				If (IsNumeric(tmpChr) = true) and (j < Len(strPixMap)) Then
					pixRepeat = pixRepeat & tmpChr
				Else
'					end pixel map?
					If IsNumeric(tmpChr) = true Then
						pixRepeat = pixRepeat & tmpChr
					End If
	
'					draw pixel
					If (drawPixel = true) and (IsNumeric(pixRepeat) = true) Then
						For k=1 to CInt(pixRepeat)
							curPos = curPos + 1
							Bitmap((valTopMargin + i),curPos) = TColor
						Next
					ElseIf IsNumeric(pixRepeat) = true Then
						curPos = curPos + CInt(pixRepeat)
					End If
	
'					what is new command?
					If tmpChr = "#" Then
						drawPixel = true
					Else
						drawPixel = false
					End If
					pixRepeat = vbNullString
				End If
			Next
		Next
	End Sub

	Sub PrepareBitmap(valSecureCode)
		Dim i, j
'		image dimensions
		ImageWidth = UBound(Bitmap,2)
		ImageHeight = UBound(Bitmap,1)
	
'		char and text width
		reDim arrTextWidth(CodeLength)
		arrTextWidth(0) = 0
		For i=1 to CodeLength
			arrTextWidth(i) = CInt(GetCharMap(Mid(secureCode,i,1))(0))
			arrTextWidth(0) = arrTextWidth(0) + arrTextWidth(i)
		Next
		arrTextWidth(0) = arrTextWidth(0) + ((CodeLength - 1) * CharTracking)
	
'		text height
		TextHeight = CInt(FontMap(0)(0))
	
'		left margin
		LeftMargin = Round((ImageWidth - arrTextWidth(0)) / 2)
	
'		top margin
		reDim arrTopMargin(CodeLength)
		arrTopMargin(0) = Round((ImageHeight - TextHeight) / 2)
		If RndTopMargin = true Then
			For i=1 to CodeLength
				arrTopMargin(i) = RndInterval(Int(arrTopMargin(0) / 2),(arrTopMargin(0) + Round(arrTopMargin(0) / 2)))
			Next
		Else
			For i=1 to CodeLength
				arrTopMargin(i) = arrTopMargin(0)
			Next
		End If
	
'		color selection
		i = RndInterval(0,UBound(ColorMap))
		BColor = ColorMap(i)(0)
		NColor = ColorMap(i)(1)
		TColor = ColorMap(i)(2)
	
'		Apply background effect
		If NoiseEffect = 3 Then
			AddNoise()
		End If
	
'		write text
		For i=1 to CodeLength
'			calculate cursor pos
			CursorPos = 0
			For j=(i-1) to 1 step -1
				CursorPos = CursorPos + arrTextWidth(j) + CharTracking
			Next
			CursorPos = LeftMargin + CursorPos
	
'			write active char
			WriteCanvas Mid(secureCode,i,1),arrTopMargin(i)
		Next
	End Sub

	Sub DrawLine(x0, y0, x1, y1, valClr)
'		Reference from Donald Hearn and M. Pauline Baker, Computer Graphics C Version
		Dim m, b, dx, dy
	
		If (NoiseEffect = 4) and (Bitmap(y0,x0) = TColor) Then
			clrNoise = vbNullString
		Else
			clrNoise = valClr
		End If
		Bitmap(y0,x0) = clrNoise
	
		dx = x1 - x0
		dy = y1 - y0
		If Abs(dx) > Abs(dy) Then
			m = (dy / dx)
			b = y0 - (m * x0)
	
			If dx < 0 Then
				dx = -1
			Else
				dx = 1
			End If
	
			Do While x0 <> x1
				x0 = x0 + dx
	
				If (NoiseEffect = 4) and (Bitmap(Round((m * x0) + b),x0) = TColor) Then
					clrNoise = vbNullString
				Else
					clrNoise = valClr
				End If
				Bitmap(Round((m * x0) + b),x0) = clrNoise
			loop
		ElseIf dy <> 0 Then
			m = (dx / dy)
			b = x0 - (m * y0)
	
			If dy < 0 Then
				dy = -1
			Else
				dy = 1
			End If
	
			Do While y0 <> y1
				y0 = y0 + dy
	
				If (NoiseEffect = 4) and (Bitmap(y0,Round((m * y0) + b)) = TColor) Then
					clrNoise = vbNullString
				Else
					clrNoise = valClr
				End If
				Bitmap(y0,Round((m * y0) + b)) = clrNoise
			loop
		End If
	End Sub

	Sub AddNoise()
		Dim median, i, j, x0, y0, x1, y1, dx, dy, dxy
	
		If NoiseEffect = 1 Then
			clrNoise = vbNullString
		Else
			clrNoise = NColor
		End If
	
		For i=1 to NoiseLine
			x0 = RndInterval(1,ImageWidth)
			y0 = RndInterval(1,ImageHeight)
			x1 = RndInterval(1,ImageWidth)
			y1 = RndInterval(1,ImageHeight)
	
'			Check minimum line length
			dx = Abs(x1 - x0)
			dy = Abs(y1 - y0)
			median = Round(Sqr((dx * dx) + (dy * dy))/2)
			If median < MinLineLength Then
				dxy = MinLineLength - median
	
				If x1 < x0 Then
					dx = -1
				Else
					dx = 1
				End If
	
				If y1 < y0 Then
					dy = -1
				Else
					dy = 1
				End If
	
				For j=1 to dxy
					If ((x1 + dx) < 1) or ((x1 + dx) > ImageWidth) or ((y1 + dy) < 1) or ((y1 + dy) > ImageHeight) Then
						Exit For
					End If
					x1 = x1 + dx
					y1 = y1 + dy
				Next
			End If
	
'			Draw noise line
			DrawLine x0,y0,x1,y1,clrNoise
		Next
	End Sub

	Function FormatHex(byval valHex,byval fixByte,fixDrctn,valReverse)
		fixByte = fixByte * 2
		tmpLen = Len(valHex)
		If fixByte > tmpLen Then
			tmpFixHex = String((fixByte - tmpLen),"0")
			If fixDrctn = 1 Then
				valHex = valHex & tmpFixHex
			Else
				valHex = tmpFixHex & valHex
			End If
		End If
	
		If valReverse = true Then
			tmpHex = vbNullString
			For cFrmtHex=1 to Len(valHex) step 2
				tmpHex = Mid(valHex,cFrmtHex,2) & tmpHex
			Next
			FormatHex = tmpHex
		Else
			FormatHex = CStr(valHex)
		End If
	End Function

	Sub SendHex(valHex)
		For cHex = 1 to Len(valHex) step 2
			Response.BinaryWrite ChrB(CByte("&H" & Mid(valHex,cHex,2)))
		Next
	End Sub

	Sub SendBitmap()
		If (ImageWidth mod 4) <> 0 Then
			BmpEndLine = String((4-(ImageWidth mod 4))*2,"0")
		Else
			BmpEndLine = vbNullString
		End If
		BmpInfoHeader = Array("28000000","00000000","00000000","0100","0800","00000000","00000000","120B0000","120B0000","00000000","00000000")
		BmpInfoHeader(1) = FormatHex(Hex(ImageWidth),4,0,true)
		BmpInfoHeader(2) = FormatHex(Hex(ImageHeight),4,0,true)
		BmpInfoHeader(6) = FormatHex(Hex((ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
		BmpInfoHeader(9) = FormatHex(Hex(Len(BmpColorMap)/8),4,0,true)
		BmpInfoHeader(10) = BmpInfoHeader(9)
		BmpHeader = Array("424D","00000000","0000","0000","00000000")
		BmpHeader(1) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2) + (ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
		BmpHeader(4) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2)),4,0,true)
	
		Response.Clear
		Response.Buffer = True
		Response.ContentType = "image/bmp"
		Response.AddHeader "Content-Disposition", "inline; filename=captcha.bmp"
		Response.CacheControl = "no-cache"
		Response.AddHeader "Pragma", "no-cache"
		Response.Expires = -1
	
		SendHex(Join(BmpHeader,""))
		SendHex(Join(BmpInfoHeader,""))
		SendHex(BmpColorMap)
		For y=ImageHeight to 1 step -1
			For x=1 to ImageWidth
				tmpHex = Bitmap(y,x)
				If tmpHex = vbNullString Then
					SendHex(BColor)
				Else
					SendHex(tmpHex)
				End If
			Next
			SendHex(BmpEndLine)
		Next
		Response.Flush
	End Sub

%>